!     FITSVV       FITS I/O specific subroutines.
!     Copyright (C) 1997  Filip Hroch, Masaryk University, Brno, CZ
!                    
!
! This file contain FITS specific subroutines relating to the input 
! and output of data in this format.
!
! Filip Hroch                         1996, August
!
! 1997, March        Test under Solaris & rewriting 
! 1999, september  - rewrited to F90
!
!***********************************************************************
!
! Current contents (A * designates a subroutine called directly by
!      a DAOPHOT command.  The others are called from within other
!      subroutines.)
!
! * ATTACH  interprets an ATTACH command and opens a picture.
!
! Warning: below subroutines no more need:
!
!   RDARAY  reads a rectangular data subarray from a picture file.
!
!   WRARAY  writes a rectangular data subarray into a picture file.
!
! --------------------------------------------------------------------

Module ImageVV

contains

!***********************************************************************

      subroutine  attach (nafile, ncol, nrow, image, fstat)

!=======================================================================
!
! FITS-specific subroutine for open a disk file containing a
! CCD picture.
!
! Arguments
!
! NAFILE (INPUT/OUTPUT) is the VMS filename of the desired input
!        picture.  If the character string NAFILE does not contain a
!        filename extension, the filename extension '.DST' will be
!        supplied.
!
! !!! NOT implemented in muniphot:
! 
! NU (INPUT) IS NUMBER OF UNIT WITH SCRATCH FILE
!        ORIGINALY FITS FILE DATA WITH PICTURE COPYING TO SCRATCH
!        FILE, FOR FAST READ/WRITE
!
!   OPEN (INPUT/OUTPUT) is a logical variable.  It is .TRUE. while
!        a picture file is open.
!
! When the file 'NAFILE' is opened, the structure it contains is given
! the top-level name 'IMAGE'
!
!=======================================================================
     
      implicit none

      character(len=*) :: nafile
      integer :: ncol, nrow 
      integer, save :: ncol0 = 0, nrow0 = 0
      real, pointer :: image(:,:)
      logical, save :: alocated = .false.     
      
      character(len=80) :: object,date,time,buf

! FITS variables for image
      integer, parameter :: DIM = 2
      integer, parameter :: MINVALUE = 0
      Integer :: fstat,fBlockSize,fNaxis,fNaxes(DIM),fPCount,fGCount,fBitPix
      Logical :: fSimple,fExtend, anyf
!      Real :: fscale, fzero

!-----------------

      fstat = 0
! frame initialisation
      Call ftopen(11,nafile,0,fBlockSize,fstat)
      Call ftghpr(11,DIM,fSimple,fBitPix,fNaxis,fNaxes,fPCount,fGCount,fExtend,fstat)
      if( fstat /= 0 ) goto 666
      ncol = fNaxes(1)      
      nrow = fNaxes(2)      

! some parameters
      Call ftgkys(11,'OBJECT',object,buf,fstat)
      if( fstat /= 0 ) then
          object = ' '
          fstat = 0
       endif
      Call ftgkys(11,'DATE-OBS',date,buf,fstat)
      if( fstat /= 0 ) then
         date = ' '
         fstat = 0
      endif
      Call ftgkys(11,'UT',time,buf,fstat)
      if( fstat /= 0 ) then
         time = ' '
         fstat = 0
      endif

      write(*,*) '    Object              Date                UT'
      write(*,*) '    ',object(1:20),date(1:20),time(1:20)
      write(*,*) '    Picture size: ',ncol, nrow

      if( .not. alocated ) then
         alocated = .true.
         ncol0 = ncol
         nrow0 = nrow
         Allocate(image(ncol,nrow))
      else if( alocated )then
         if( (ncol0 /= ncol) .or. (nrow0 /= nrow) )then
            deallocate(image)
            ncol0 = ncol
            nrow0 = nrow
            Allocate(image(ncol,nrow))
         endif
      endif

! data
      Call ftg2de(11,1,MINVALUE,ncol,ncol,nrow,image,anyf,fstat)
      Call ftclos(11,fstat)
      if( fstat /= 0 ) goto 666

      return
      
! Error
666   continue
      write(*,*) "I/O error #",fstat
      write(*,*) 'The following FITS I/O error(s) has been occured:'
        do
          Call ftgmsg(buf)
          if( buf == ' ' ) exit
          write(*,*) trim(buf)
        enddo
      end subroutine

end module


